home *** CD-ROM | disk | FTP | other *** search
/ Dictionaries & Language / Dictionaries and Language (Chestnut CD-ROM) (1993).iso / hebrew / hebrwch / hebrew.bas next >
Encoding:
BASIC Source File  |  1985-12-03  |  10.4 KB  |  314 lines
  1. 10 ON ERROR GOTO 2000
  2. 20 DEFINT A-Z
  3. 30 DIM DEFN.BYTE(12)
  4. 40 ESC$ = CHR$(27)
  5. 50 RAM.ON$ = ESC$ + "%" + CHR$(1) + CHR$(0)
  6. 60 ROM.ON$ = ESC$ + "%" + CHR$(0) + CHR$(0)
  7. 70 CR$ = CHR$(13)
  8. 80 CLS
  9. 90 PRINT  "FX-series pre-processor for Hebrew and Yiddish output": PRINT
  10. 100 PRINT "Copyright (C) 1985 by Arnold M. Kuzmack"
  11. 101 PRINT "                      3912 Montrose Dr."
  12. 102 PRINT "                      Chevy Chase, MD  20815"
  13. 103 PRINT
  14. 104 PRINT "                      (301) 986-0274"
  15. 105 PRINT: PRINT
  16. 110 PRINT "This program may be copied and distributed free of charge,"
  17. 120 PRINT "but MAY NOT BE SOLD except by permission of the author.": PRINT
  18. 121 PRINT "If you find it useful, a contribution of $15.00"
  19. 122 PRINT "would be appreciated.": PRINT: PRINT
  20. 130 INPUT "File to be printed"; FILE$
  21. 140 LENGTH = LEN(FILE$)
  22. 150 FOR I = 1 TO LENGTH
  23. 160 LTR.VAL = ASC(MID$(FILE$,I,1))
  24. 170 IF LTR.VAL >= 97 THEN MID$(FILE$,I) = CHR$(LTR.VAL - 32)
  25. 180 NEXT I
  26. 190 OPEN "I", #1, FILE$
  27. 200 PRINT
  28. 210 GOSUB 4000
  29. 270 INPUT "Double-strike output"; A$
  30. 280 DBL.STRK = (A$ = "Y") OR (A$ = "y")
  31. 290 INPUT "Total length of printer line (e. g., 80)"; LINE.LEN
  32. 300 INPUT "Desired right margin"; RMAR
  33. 310 PRINT: INPUT "Be sure printer is ON, then press RETURN", A$: PRINT
  34. 320 GOSUB 1000
  35. 325 PRINT "Press ESC to abort, any other key to pause.": PRINT
  36. 330 WHILE NOT END.TXT
  37. 335 GOSUB 4500
  38. 340 GOSUB 3000
  39. 350 A$ = A.W1$
  40. 360 LENGTH = LEN(A$)
  41. 370 IF LENGTH = 0 THEN LPRINT: GOTO 680
  42. 380 B$ = "": C$ = "": COUNT = 0: SPC.ON = -1
  43. 390 FOR I = 1 TO LENGTH
  44. 400 LTR$ = MID$(A$,I,1)
  45. 410 IF ASC(LTR$) > 128 THEN LTR$ = CHR$(ASC(LTR$) - 128)
  46. 420 IF LTR$ <> "\" GOTO 460
  47. 430 IF ENG = 0 THEN 
  48.     ENG = 1:
  49.     B$ = RAM.ON$ + B$:
  50.     GOTO 550
  51. 440 IF ENG = 1 THEN 
  52.     ENG = 0:
  53.     B$ = ROM.ON$ + C$ + B$:
  54.     C$ = ""
  55. 450 GOTO 550
  56. 460 '
  57. 470 IF LTR$ = "_" THEN
  58.     B$ = ESC$ + "-1" + B$:
  59.     GOTO 550 ' Underline
  60. 480 IF LTR$ = "@" THEN
  61.     B$ = ESC$ + "!" + FONT$ + ESC$ + "-0" + B$:
  62.     GOTO 550
  63. 490 IF LTR$ = "^" THEN
  64.     B$ = ESC$ + "!!" + B$:
  65.     SPC.ON = 0:
  66.     GOTO 550 ' 6 cpi
  67. 500 IF LTR$ = "#" THEN
  68.     B$ = ESC$ + "!$" + B$:
  69.     SPC.ON = 0:
  70.     GOTO 550 ' 8.3 cpi
  71. 510 IF LTR$ = "|" THEN
  72.     B$ = ESC$ + "!8" + B$:
  73.     SPC.ON = 0:
  74.     GOTO 550 ' 5 cpi
  75. 520 IF ENG = 0 THEN B$ = LTR$ + B$
  76. 530 IF ENG = 1 THEN C$ = C$ + LTR$
  77. 540 IF ASC(LTR$) >= 32 
  78.     THEN COUNT = COUNT + 1 
  79.     ELSE COUNT = COUNT - 1
  80. 550 NEXT I
  81. 560 B$ = C$ + B$
  82. 570 '
  83. 580 '    Chop off leading spaces.
  84. 590 '
  85. 600 WHILE ASC(B$) = 32
  86. 610 B$ = RIGHT$(B$, LEN(B$) - 1)
  87. 620 COUNT = COUNT - 1
  88. 630 WEND
  89. 640 SP = LINE.LEN - RMAR - COUNT
  90. 650 IF NOT SPC.ON GOTO 670
  91. 660 IF SP >= 0 
  92.     THEN B$ = SPACE$(SP) + B$ 
  93.     ELSE PRINT "Warning -- line too long."
  94. 670 IF DBL.STRK 
  95.     THEN LPRINT B$; CR$; B$ 
  96.     ELSE LPRINT B$
  97. 680 WEND
  98. 690 PRINT "Printing complete.": PRINT
  99. 700 END
  100. 1000 '
  101. 1010 '
  102. 1020 '    Subroutine to load characters into printer RAM.
  103. 1030 '
  104. 1040 LPRINT ESC$ + "!" + FONT$
  105. 1050 L$ = CHR$(0): LPRINT ESC$ + ":" + L$ + L$ + L$;:  '  Download ROM chars
  106. 1060 L$ = ESC$ + "&" + L$
  107. 1070 READ ASCII
  108. 1080 WHILE ASCII >= 0
  109. 1090 LPRINT L$ + CHR$(ASCII) + CHR$(ASCII);
  110. 1100 FOR I = 1 TO 12
  111. 1110 READ DEFN.BYTE(I)
  112. 1120 LPRINT CHR$(DEFN.BYTE(I));
  113. 1130 NEXT
  114. 1140 READ ASCII
  115. 1150 WEND
  116. 1160 LPRINT ESC$ + "%" + CHR$(1) + CHR$(0);
  117. 1170 LPRINT ESC$ + "jH";  '  Reverse feed two lines
  118. 1180 RETURN
  119. 2000 '
  120. 2010 '
  121. 2020 '    Error-trapping subroutine for missing file.
  122. 2030 '
  123. 2040 IF ERR <> 53 OR ERL <> 190 THEN 
  124.     ON ERROR GOTO 0
  125. 2045 CLOSE #1
  126. 2050 PRINT
  127. 2060 PRINT "Can't find "; FILE$
  128. 2070 PRINT "May be misspelled or on different drive."
  129. 2080 PRINT "Try again."
  130. 2090 PRINT
  131. 2100 RESUME 130
  132. 3000 '
  133. 3010 '
  134. 3020 '    Library subroutine, category WORD PROCESSING, number 1
  135. 3030 '
  136. 3040 '    Subroutine to return next line from #1 as A.W1$.
  137. 3050 '    Reads until SOFT or HARD CR is encountered.
  138. 3060 '    A.W1$ = "" for blank line.
  139. 3070 '    Sets END.TXT = -1 when last line is returned
  140. 3080 '
  141. 3090 '    All internal variable names end in .W1
  142. 3100 '    BUFF.W1$ is buffer to hold text read but not yet returned
  143. 3110 '    BLANK.LN.W1 = -1 if blank line encountered in last execution
  144. 3120 '
  145. 3130 '    To insure correct operation, paragraphs should be separated
  146. 3140 '    by blank lines.
  147. 3150 '
  148. 3160 SCR.W1$ = CHR$(141)
  149. 3170 A.W1$ = ""
  150. 3180 IF BLANK.LN.W1 THEN BLANK.LN.W1 = 0: GOTO 3680
  151. 3190 '
  152. 3200 '    Set SKIP.W1 true if BUFF.W1$ is not empty,
  153. 3210 '    i.e., not first time through after reading so
  154. 3220 '    want to skip line 3340
  155. 3230 '
  156. 3240 IF BUFF.W1$ = "" THEN LINE INPUT #1, BUFF.W1$ ELSE SKIP.W1 = -1
  157. 3250 '
  158. 3260 '    If blank line is read, return A.W1$ = ""
  159. 3270 '
  160. 3280 IF BUFF.W1$ = "" GOTO 3680
  161. 3290 '
  162. 3300 '    Eliminates soft LF (ASCII 138) and returns blank line
  163. 3310 '
  164. 3320 IF ASC(BUFF.W1$) = 138 AND LEN(BUFF.W1$) = 1 THEN 
  165.     BUFF.W1$ = "": GOTO 3680
  166. 3330 '
  167. 3340 '    Chop off initial LF
  168. 3350 '
  169. 3360 IF ASC(BUFF.W1$) = 10 OR ASC(BUFF.W1$) = 138 THEN
  170.     BUFF.W1$ = RIGHT$(BUFF.W1$, LEN(BUFF.W1$) - 1):
  171.     FLAG.W1 = -1
  172. 3370 '
  173. 3380 '    End-of-paragraph encountered if length <= 254
  174. 3390 '
  175. 3400 IF SKIP.W1 THEN SKIP.W1 = 0: GOTO 3420
  176. 3410 IF (NOT FLAG.W1 AND LEN(BUFF.W1$) <= 254) OR 
  177.     (FLAG.W1 AND LEN(BUFF.W1$) <= 253) 
  178.     THEN PAR.W1 = -1
  179. 3420 FLAG.W1 = 0
  180. 3430 '
  181. 3440 '    Search for soft CR
  182. 3450 '
  183. 3460 I.W1 = INSTR(BUFF.W1$, SCR.W1$)
  184. 3470 '
  185. 3480 '    Last line of paragraph
  186. 3490 '
  187. 3500 IF I.W1 = 0 AND PAR.W1 THEN 
  188.     A.W1$ = A.W1$ + BUFF.W1$:
  189.     BUFF.W1$ = "":
  190.     PAR.W1 = 0:
  191.     GOTO 3680
  192. 3510 '
  193. 3520 '    Soft CR found BEFORE end of BUFF.W1$
  194. 3530 '
  195. 3540 IF I.W1 > 0 AND I.W1 < LEN(BUFF.W1$) THEN
  196.     A.W1$ = A.W1$ + LEFT$(BUFF.W1$, I.W1 - 1):
  197.     BUFF.W1$ = RIGHT$(BUFF.W1$, LEN(BUFF.W1$) - I.W1 - 1):
  198.     GOTO 3680
  199. 3550 '
  200. 3560 '    Soft CR is last character in BUFF.W1$
  201. 3570 '
  202. 3580 IF I.W1 > 0 AND I.W1 = LEN(BUFF.W1$) THEN
  203.     A.W1$ = A.W1$ + LEFT$(BUFF.W1$, I.W1 - 1):
  204.     BUFF.W1$ = "":
  205.     GOTO 3680
  206. 3590 '
  207. 3600 '    To reach this point, must have I.W1 = 0 and PAR.W1 = 0
  208. 3610 '    Need to read more to reach end of line
  209. 3620 '
  210. 3630 A.W1$ = A.W1$ + BUFF.W1$
  211. 3640 BUFF.W1$ = ""
  212. 3650 IF NOT EOF(1) THEN LINE INPUT #1, BUFF.W1$
  213. 3660 IF LEN(BUFF.W1$) = 1 THEN IF ASC(BUFF.W1$) = 138 THEN 
  214.     BLANK.LN.W1 = -1:
  215.     GOTO 3680
  216. 3670 IF BUFF.W1$ <> ""         
  217.     THEN 3410
  218.     ELSE BLANK.LN.W1 = -1
  219. 3680 IF EOF(1) AND BUFF.W1$ = "" THEN END.TXT = -1
  220. 3690 RETURN
  221. 4000 '
  222. 4010 '
  223. 4020 '    Subroutine to display menu of fonts and
  224. 4030 '    return appropriate value of Master Select 
  225. 4040 '    Code as FONT$
  226. 4050 '
  227. 4060 PRINT: PRINT "Menu of available type fonts:"
  228. 4070 PRINT
  229. 4080 PRINT "1.  Pica"; TAB(30); "9.  Double-strike pica"
  230. 4090 PRINT "2.  Elite"; TAB(30); "10.  Double-strike elite"
  231. 4100 PRINT "3.  Compressed"; TAB(30); "11.  Double-strike compressed"
  232. 4110 PRINT "4.  Expanded pica"; TAB(30); "12.  Double-strike expanded pica"
  233. 4120 PRINT "5.  Expanded elite"; TAB(30); "13.  Double-strike expanded elite"
  234. 4130 PRINT "6.  Expanded compressed"; TAB(30); "14.  Double-strike expanded compressed"
  235. 4140 PRINT
  236. 4150 PRINT "7.  Emphasized pica"; TAB(30); "15.  Double-strike emphasized pica"
  237. 4160 PRINT "8.  Emphasized expanded pica"; TAB(30); "16.  Double-strike emphasized expanded pica"
  238. 4170 PRINT
  239. 4180 FONT$ = ""
  240. 4190 INPUT "Enter your choice of font (RETURN for emphasized pica) ", FONTNUM
  241. 4200 IF FONTNUM = 1 THEN FONT$ = "@"
  242. 4210 IF FONTNUM = 2 THEN FONT$ = "A"
  243. 4220 IF FONTNUM = 3 THEN FONT$ = "D"
  244. 4230 IF FONTNUM = 4 THEN FONT$ = " "
  245. 4240 IF FONTNUM = 5 THEN FONT$ = "!"
  246. 4250 IF FONTNUM = 6 THEN FONT$ = "$"
  247. 4260 IF FONTNUM = 7 THEN FONT$ = "H"
  248. 4270 IF FONTNUM = 8 THEN FONT$ = "*"
  249. 4280 IF FONTNUM = 9 THEN FONT$ = "P"
  250. 4290 IF FONTNUM = 10 THEN FONT$ = "Q"
  251. 4300 IF FONTNUM = 11 THEN FONT$ = "T"
  252. 4310 IF FONTNUM = 12 THEN FONT$ = "0"
  253. 4320 IF FONTNUM = 13 THEN FONT$ = "1"
  254. 4330 IF FONTNUM = 14 THEN FONT$ = "4"
  255. 4340 IF FONTNUM = 15 THEN FONT$ = "X"
  256. 4350 IF FONTNUM = 16 THEN FONT$ = "8"
  257. 4360 PRINT
  258. 4370 IF FONTNUM = 0 THEN FONT$ = "H"
  259. 4380 IF FONT$ <> "" THEN RETURN
  260. 4390 PRINT "You must enter 1-16 or RETURN.  Try again."
  261. 4400 GOTO 4060
  262. 4500 '
  263. 4510 '
  264. 4520 '    Subroutine to monitor for ABORT or PAUSE commands.
  265. 4530 '
  266. 4540 AA$ = INKEY$
  267. 4550 IF LEN(AA$) = 0 THEN RETURN
  268. 4560 IF ASC(AA$) = 27 THEN 
  269.      PRINT: PRINT: PRINT "Aborted.": PRINT:
  270.      END
  271. 4570 PRINT: PRINT
  272. 4580 INPUT "Press RETURN to resume.", AA$
  273. 4590 PRINT: PRINT "Press ESC to abort, any other key to pause.": PRINT
  274. 4600 RETURN
  275. 5000 '
  276. 5010 '
  277. 5020 DATA 97,128,38,8,16,0,8,0,4,8,50,0,0 '      a = aleph
  278. 5030 DATA 65,1,76,16,34,0,18,0,10,16,100,0,0 '   A = patah-aleph
  279. 5040 DATA 111,1,76,16,34,0,19,0,10,16,100,0,0 '  o = kamatz-aleph
  280. 5050 DATA 98,128,34,0,34,0,34,0,34,28,2,0,0 '    b = bet
  281. 5060 DATA 103,128,0,0,34,0,36,0,30,0,0,0,0 '     g = gimel
  282. 5070 DATA 100,128,32,0,32,0,32,0,32,30,32,0,0 '  d = dalet
  283. 5080 DATA 104,128,38,0,32,0,32,0,32,16,14,0,0 '  h = he'
  284. 5090 DATA 117,128,0,0,0,32,30,0,0,0,0,0,0 '      u = vav
  285. 5100 DATA 122,128,0,0,32,0,46,16,32,0,0,0,0 '    z = zayin
  286. 5110 DATA 72,128,62,0,32,0,32,0,32,16,14,0,0 '   H = het
  287. 5120 DATA 116,128,60,2,0,2,0,34,0,34,28,0,0 '    t = tet
  288. 5130 DATA 105,128,0,0,0,32,24,0,0,0,0,0,0 '      i = yod
  289. 5140 DATA 107,128,34,0,34,0,34,0,20,8,0,0,0 '    k = kaph
  290. 5150 DATA 75,1,64,0,64,0,64,0,32,31,0,0,0 '      K = final kaph
  291. 5160 DATA 108,128,224,0,32,0,32,2,36,8,48,0,0 '  l = lamed
  292. 5170 DATA 109,128,38,24,0,16,32,2,32,18,12,0,0 ' m = mem
  293. 5180 DATA 77,128,46,16,34,0,34,0,34,0,30,0,0 '   M = final mem
  294. 5190 DATA 110,128,0,2,32,2,32,30,0,0,0,0,0 '     n = nun
  295. 5200 DATA 78,1,0,0,0,64,63,0,0,0,0,0,0 '         N = final nun
  296. 5210 DATA 115,128,40,20,34,0,34,0,34,20,8,0,0 '  s = samekh
  297. 5220 DATA 101,128,34,16,10,4,2,0,2,4,56,0,0 '    e = ayin
  298. 5230 DATA 112,128,50,8,34,0,42,0,34,28,0,0,0 '   p = pe'
  299. 5240 DATA 102,128,50,8,34,0,34,0,34,28,0,0,0 '   f = fe'
  300. 5250 DATA 70,1,96,16,64,0,64,0,64,63,0,0,0 '     F = final fe'
  301. 5260 DATA 99,128,34,0,18,0,10,10,14,16,34,0,0 '  c = tsadi
  302. 5270 DATA 67,1,64,32,16,8,4,10,17,96,0,0,0 '     C = final tsadi
  303. 5280 DATA 113,1,95,0,64,0,68,8,80,32,0,0,0 '     q = kuf
  304. 5290 DATA 114,128,32,0,32,0,32,0,32,30,0,0,0 '   r = resh
  305. 5300 DATA 83,128,56,4,2,4,58,0,2,4,56,0,0 '      S = shin
  306. 5310 DATA 84,128,34,28,32,0,32,0,32,16,14,0,0 '  T = tav
  307. 5320 DATA 83,128,56,4,2,4,58,0,2,4,56,0,0 '      S = shin
  308. 5330 DATA 108,128,224,0,32,0,32,2,36,8,48,0,0 '  l = lamed
  309. 5340 DATA 69,128,0,32,24,0,0,32,24,0,0,0,0'      E = 2 yuds
  310. 5350 DATA 73,1,0,64,50,0,2,64,50,0,0,0,0'        I = patah 2 yuds
  311. 5360 DATA 118,128,0,32,30,0,0,32,30,0,0,0,0'     v = 2 vavs
  312. 5370 DATA 69,128,0,32,24,0,0,32,24,0,0,0,0'      E = 2 yuds
  313. 5380 DATA -1
  314.